COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
C00008 ENDMK
C⊗;
C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
	SUBROUTINE HOMX
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(0/7),JJ2,POS
	1 /STF/RSTFAC(0/7),RSTJ2 /XRN/RN(1) 
	1/PTR/PWDS(250),ITEM,L,I,IX
	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
	EQUIVALENCE (R3,RJQ(1)),(R7,RJQ(5)),(R9,RJQ(7))
	1,(R4,RJQ(2)),(R8,RJQ(6)),(R5,RJQ(3)),(R10,RJQ(8))
	
	JJ2=1000
C  THE STAFF # =R2
	DO 1 K=1,ITEM
	IF(CODN(K,L).NE.6)GO TO 1
C RETURNS POINTER IN L
C%%%%%%%%%%%
	IF(R2.GT.7)GO TO 2
C  J2=STAFF #.  >7 = ALL STAVES.
	IF(RN(L+2).NE.R2)GO TO 1
2	R7=RN(L+7)
	IF(R7)GO TO 1
C SKIP TREMOLO AND UNATTACHED PARTIAL BEAMS.
	RS=RN(L+2)
C STAFF OF THIS BEAM
	ISD=IFIX(R7/10.)
C STEM DIRECTION. 1=UP  2=DOWN
	RM=RSTFAC(IFIX(RS))
	RSTJ2=RM
C SIZE FACTOR
	RL=RN(L+3)
	RR=RN(L+6)
C OVERALL LEFT-RIGHT LIMITS
	PL=RL
	PR=RR
C LEFT-RIGHT POS. TO BE USED
	RLH=RN(L+4)
	RRH=RN(L+5)
C LEFT-RIGHT HEIGHTS
	RMIN=1.
	MIN=-1
C  FLAG FOR MINI-NOTES AND BEAMS
	IF(ABS(RLH).LE.80)GO TO 3
	MIN=0
	RMIN=.6
	RM=RM*.6
C MINI SIZE FACTOR
	RLH=ABS(RLH)-100.
3	WC=RN(L)
C  WORD COUNT
	T=-1
	IF(WC.LT.6)GO TO 4
	R8=RN(L+8)
	IF(R8.EQ.0)GO TO 4
	IF(R8)GO TO 1
	IF(WC.LT.7)GO TO 4
	R9=RN(L+9)
	IF(R9.EQ.0)GO TO 4
	PL=R8
	PR=R9
C  POS. OF INNER PARTIAL BEAM.
	IF(WC.LT.8)GO TO 4
	IF(RN(L+10).GT.0)T=RN(L+10)+T
4	IR7=AMOD(R7,10.0)+T
C NUMBER OF BEAMS
	PL=PL-.1
	PR=PR+.1
C FOR ROUND-OFF ERROR
	T=RR-RL
C  TOTAL LENGTH OF FULL BEAM
	TH=RRH-RLH
C  TOTAL HEIGHT
	T=TH/T
C FACTOR

	DO 5 J=1,ITEM
	IF(CODN(J,L).NE.1)GO TO 5
	IF(RN(L+2).NE.RS)GO TO 5
C SKIP IF NOT ON RIGHT STAFF
	R5=RN(L+5)
	IF(R5.LT.10)GO TO 5
C SKIP IF NO STEM ON NOTE
	R3=RN(L+3)
	IXD=0
CW	A=0
	IF(IFIX(R5/10.).EQ.ISD)GO TO 12
C A IS FOR HORZ. DISPLACEMENT DUE TO OPPOSITE STEM DIRECTIONS.
	IXD=-1
	A=2.44*RM
C  A=WIDTH OF NOTE*SIZE FACTOR   + OR -
	IF(ISD.EQ.1)A=-A
	R3=A+R3
12	IF(R3.LT.PL)GO TO 5
	IF(R3.GT.PR)GO TO 5
C SKIP IF NOT IN BOUNDS OF BEAM SEGMENT.
CW	R3=A+R3
	R4=RN(L+4)
	IF(ABS(R4).LE.80)GO TO 10
	IF(MIN)GO TO 5
C NOW MINI-NOTE
	R4=ABS(R4)-100.
	GO TO 11
10	IF(MIN.EQ.0)GO TO 5
11	R6=T*(R3-RL)
	R8=RLH+R6-R4
C ADJUSTED STEM LENGTH
	IF(ISD.EQ.2)R8=-R8
	IF(IXD.EQ.0)GO TO 9
	R9=(IR7*1.571429-13.714)*RMIN
	R8=-R8
9	IF(RN(L).LT.8)GO TO 7
CHECK P10 FOR STAFF CHANGE FLAG
	R10=RN(L+10)
	IF(R10.LE.0)GO TO 7
	N=-1
	IF(R10.EQ.2)N=-N
C N =-1 = ON STAFF BELOW, =1 = ABOVE.
	M=RS
	R3=ABS((STFF(M+N)-STFF(M))/(RSTJ2*7))
	IF(IXD)GO TO 13
	IF(R10.NE.ISD)R3=-R3
C ABOVE FOR STEMS SAME DIR, STAFF CHNG IN SAME DIR.
13	R8=R8+R3
C ADDS DISTANCE TO OTHER STAFF - CONVERTED TO NOTE NUMBERS.
7	IF(IXD)R8=R8+R9
C IF OPPOSITE STEM DIR., SUBTRACT (2*STEM AND EXTRA BEAM SPACE)*SIZE
	IF(R8.LT.-5)GO TO 5
C AFTER ALL THAT, IF BEAM IS TOO SMALL THEN IGNORE IT.
	IF(JJ2.GT.J)JJ2=J
C  POINT TO 1ST ITEM TO RE-DISPLAY
	RN(L+8)=R8
	R7=RN(L+7)
C NEXT DELETES TAILS
	IF(R7.EQ.0)GO TO 5
	N=AMOD(R7,10.)
	RN(L+7)=R7-N
5	CONTINUE
1	CONTINUE
	IF(JJ2.EQ.1000)JJ2=-1
	END

	SUBROUTINE SHRINK(JIT)
	COMMON /XRN/RN(1) /PTR/KWDS(250),ITEM,L,I,IX/ALF/A,B,C,K,M,N
	1,MM
	IF(JIT.EQ.0)JIT=1
	MM=I
	DO 1 K=ITEM,JIT,-1
	L=KWDS(K)
	M=RN(L)
	IF(M.LE.2)GO TO 1
	J=M+2+L
	IF(RN(L+1).NE.1)GO TO 5
	IF(RN(L+8).EQ.0)RN(L+8)=999
C  NOTES MUST HAVE AT LEAST 8 PARAMS.
5	DO 2 N=J,L,-1
2	IF(RN(N).NE.0)GO TO 3
	GO TO 1
3	IF(N.EQ.J)GO TO 1
	M=I-N
	CALL RLOOP(RN(N+1),RN(J+1),M)
	MM=J-N
	RN(L)=RN(L)-MM
C RESET THE WDCNT.
	I=I-MM
1	CONTINUE
	L=KWDS(JIT)
4	JIT=JIT+1
	L=RN(L)+3+L
C  POINTER TO NEXT ITEM
	KWDS(JIT)=L
	IF(JIT.LE.ITEM)GO TO 4
	END